Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue24/survive/UALLO.PAS

Pascal/Delphi Source File | 1997-06-11 | 5.0 KB | 219 lines

unit uAllo;

interface

uses
  Classes, uBase;

type
  TAmountsList = class(TList)
      { This is a generic class that manages a list of dollar amounts (stored
        as LongInts). }
    protected
      function GetItem(aIndex: Integer): LongInt;
      procedure SetItem(aIndex: Integer; aValue: LongInt);
    public
      procedure Add(aValue: LongInt);
      procedure Assign(aSource: TAmountsList);
      procedure ZeroOut;
      property Items[aIndex: Integer]: LongInt read GetItem write SetItem; default;
    end;

  TCredit = class
    public
      CreditNo: LongInt;
      Amount,
      AmountRemaining: LongInt;
      PaymentByMethod: TAmountsList;
      constructor Create(aNumMethods: Integer);
      destructor Destroy; override;
    end;

  TCreditList = class(TList)
    protected
      function GetItem(aIndex: Integer): TCredit;
    public
      procedure Add(aCreditNo: LongInt; aAmount: LongInt);
      procedure Delete(aCreditNo: LongInt);
      property Items[aIndex: Integer]: TCredit read GetItem; default;
    end;

  TAllocationInfo = class(TPersistent)
    protected
      function GetMethodCount: Integer;
      function GetMethodName(aIndex: Integer): string;
    public
      MethodAmounts: TAmountsList;
      MethodAmountsRemaining: TAmountsList;
      Credits: TCreditList;
      TotalPaymentRemaining: LongInt;

      constructor Create;
      destructor Destroy; override;
      procedure Clear;
      procedure ComputeTotalByCredit(aCreditNo: LongInt);
      procedure ComputeTotalByMethod(aMethodNo: Integer);

      property MethodCount: Integer
        read GetMethodCount;
      property MethodName[aIndex: Integer]: string
        read GetMethodName;
    end;

implementation

uses
  dmData;

{ TAmountsList }

function TAmountsList.GetItem(aIndex: Integer): LongInt;
begin
  Result := 0;
  if aIndex < Count then
    Result := LongInt(inherited Items[aIndex]);
end;

procedure TAmountsList.SetItem(aIndex: Integer; aValue: LongInt);
begin
  inherited Items[aIndex] := Pointer(aValue);
end;

procedure TAmountsList.Add(aValue: LongInt);
begin
  inherited Add(Pointer(aValue));
end;

procedure TAmountsList.Assign(aSource: TAmountsList);
var
  I: Integer;
begin
  Clear;
  for I := 0 to aSource.Count - 1 do
    Add(aSource.Items[I]);
end;

procedure TAmountsList.ZeroOut;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I] := 0;
end;

{ TCredit }

constructor TCredit.Create(aNumMethods: Integer);
begin
  inherited Create;
  PaymentByMethod := TAmountsList.Create;
  while aNumMethods > 0 do begin
    PaymentByMethod.Add(0);
    Dec(aNumMethods);
  end;
end;

destructor TCredit.Destroy;
begin
  PaymentByMethod.Free;
  inherited Destroy;
end;

{ TCreditList }

procedure TCreditList.Add(aCreditNo: LongInt; aAmount: LongInt);
var
  Credit: TCredit;
begin
  Credit := TCredit.Create(dmDataModule.PaymentMethodsList.Count);
  Credit.CreditNo := aCreditNo;
  Credit.Amount := aAmount;
  Credit.AmountRemaining := aAmount;
  inherited Add(Credit);
end;

procedure TCreditList.Delete(aCreditNo: LongInt);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if Items[I].CreditNo = aCreditNo then begin
      inherited Delete(I);
      Break;
    end;
end;

function TCreditList.GetItem(aIndex: Integer): TCredit;
begin
  Result := nil;
  if aIndex < Count then
    Result := TCredit(inherited Items[aIndex]);
end;

{ TAllocationInfo }

constructor TAllocationInfo.Create;
var
  I: Integer;
begin
  inherited Create;
  MethodAmounts := TAmountsList.Create;
  MethodAmountsRemaining := TAmountsList.Create;
  Credits := TCreditList.Create;

  for I := 1 to MethodCount do begin
    MethodAmounts.Add(0);
    MethodAmountsRemaining.Add(0);
  end;
end;

destructor TAllocationInfo.Destroy;
begin
  MethodAmounts.Free;
  MethodAmountsRemaining.Free;
  Credits.Free;
  inherited Destroy;
end;

procedure TAllocationInfo.Clear;
var
  J: Integer;
begin
  {!! markers }
  for J := 0 to MethodCount - 1 do begin
    MethodAmounts[J] := 0;
    MethodAmountsRemaining[J] := 0;
  end;
end;

procedure TAllocationInfo.ComputeTotalByCredit(aCreditNo: LongInt);
begin
  {!!}
end;

procedure TAllocationInfo.ComputeTotalByMethod(aMethodNo: Integer);
var
  I: Integer;
begin
  MethodAmountsRemaining[aMethodNo] := MethodAmounts[aMethodNo];
  for I := 0 to Credits.Count - 1 do
    MethodAmountsRemaining[aMethodNo] := MethodAmountsRemaining[aMethodNo] -
                                         Credits[I].PaymentByMethod[aMethodNo];

  TotalPaymentRemaining := 0;
  for I := 0 to MethodCount - 1 do
    Inc(TotalPaymentRemaining, MethodAmountsRemaining[I]);
end;

function TAllocationInfo.GetMethodCount: Integer;
begin
  Result := dmDataModule.PaymentMethodsList.Count;
end;

function TAllocationInfo.GetMethodName(aIndex: Integer): string;
begin
  Result := dmDataModule.PaymentMethodsList[aIndex];
end;

end.